Retrasos de vuelos

Análisis Exploratorio

Reto

• Reto en DataSource.ai

Datos

library(data.table)
dataTrain <- fread("../data/train.csv")
dataTest <- fread("../data/test.csv")
dataSample <- fread("../data/sample.csv")

Variables

• ID: identificación de vuelo.
• DATOP: Fecha de vuelo.
• FLTID: Número de vuelo
• DEPSTN: Punto de partida
• ARRSTN: Punto de llegada
• STD: Hora de salida programada
• STA: Hora prevista de llegada
• STATUS: Estado del vuelo
• AC: Código de aeronave
• target: Tiempo de retraso

Train y Test

• Train:
  • En el conjunto de datos de train hay 107833 vuelos registrados.
  • El rango de fechas de vuelos es desde el 01-01-2016 hasta 31-12-2018.
  • Hay 1861 vuelos registrados. Cada vuelo puede estar registrado en diferentes fechas.
  • En total son 132 puntos de destino diferentes y 128 puntos de llegada.
  • Hay en total 5 estados (STATUS) de vuelo.
  • Hay 68 códigos de aeronaves diferentes.
  • El tiempo de retraso (target) está dado en minutos.

library(tidyverse)
# Train
dataTrain %>% 
  mutate(DATOP = as.Date(DATOP),
         FLTID = as.factor(FLTID),
         DEPSTN = as.factor(DEPSTN),
         ARRSTN = as.factor(ARRSTN),
         STD = as.POSIXct(STD),
         STA = gsub("\\.", ":", STA),
         STA = as.POSIXct(STA),
         STATUS = as.factor(STATUS),
         AC = as.factor(AC)) ->
  dataTrain
head(dataTrain, n = 10L)

• Test:
  • En el conjunto de test hay 9333 vuelos registrados.
  • El rango de fechas de vuelos es desde 01-05-2016 hasta 20-09-2018.
  • Hay 700 vuelos registrados.
  • En total son 82 puntos de destino y 84 puntos de llegada diferentes.
  • Los mismos 5 estados de vuelo.
  • Hay 44 códigos de aeronaves.

# Test
dataTest %>% 
  mutate(DATOP = as.Date(DATOP),
         FLTID = as.factor(FLTID),
         DEPSTN = as.factor(DEPSTN),
         ARRSTN = as.factor(ARRSTN),
         STD = as.POSIXct(STD),
         STA = gsub("\\.", ":", STA),
         STA = as.POSIXct(STA),
         STATUS = as.factor(STATUS),
         AC = as.factor(AC)) ->
  dataTest
head(dataTest, n = 10L)

Conteos

• ¿Cuántos vuelos (FLTID) del test coinciden con el train?:

table(dataTest$FLTID %in% dataTrain$FLTID)

FALSE  TRUE 
   67  9266 

• ¿Cuántos puntos de destino coinciden entre el test y train?:

table(dataTest$DEPSTN %in% dataTrain$DEPSTN)

FALSE  TRUE 
    3  9330 

• ¿Cuántos puntos de llegada coinciden entre el test y train?:

table(dataTest$ARRSTN %in% dataTrain$ARRSTN)

FALSE  TRUE 
    3  9330 

• ¿Cuántos códigos de aeronave coinciden entre el test y train?:

table(dataTest$AC %in% dataTrain$AC)

FALSE  TRUE 
   21  9312 

Nuevas variables

• Basado en las variables originales derivo las siguientes características:
  • Días del mes, días de la semana, meses y año de vuelo.
  • Agrego trimestres.
  • Agrego semana del año.
  • Agrego una variable que indique si es fin de semana.
  • Agrego una nueva variable binaria que indique si es fin de mes. Si la fecha del vuelo está entre el 28 a 31 de cada mes, lo categorizo como fin de mes.
  • Agrego una nueva variable binaria con fechas especiales. Aunque son muchas las fechas especiales que podrían ser tenidas en cuenta, incluyo el día del trabajo (1 de mayo), el día de san valentín (19 de septiembre), el día internacional de la mujer (8 de marzo), año nuevo (01 de enero), día de los reyes magos (06 de enero), noche de Hallowen (31 de octubre), noche buena (24 de diciembre), día de navidad (25 de diciembre) y fin de año (31 de diciembre).
  • Con el tiempo de salida obtengo la hora y establezco una nueva variable que define si el vuelo es en la madrugada, mañana, tarde o noche.
  • Resto el tiempo de salida con el tiempo de llegada para conocer el tiempo promedio de vuelo. El resultado estará dado en minutos, sin embargo, lo convierto a horas dividiendo sobre 60. Hay vuelos con inconsistencias en los tiempos de partida y llegada, por tal motivo el tiempo de vuelo de aquellos que superan las 24 horas les agrego NA (363 registros en total).
  • Con el tiempo promedio de vuelo clasifico los vuelos en vuelo corto (hasta 2 horas), vuelo moderado (entre 2 y 5 horas) y vuelo largo (mayor a 5 horas).
  • Cuento el número de vuelos por punto de salida. Esto supongo que servirá para observar la demanda de cada sitio (ciudad o país), esperando que donde haya más demanda posiblemente haya menor capacidad de reacción (¿o al contrario?) y quizás mayores retrasos. Lo mismo hago por punto de llegada.
  • Cuento número de vuelos por código de aeronave, en el mismo orden de ideas de oferta-demanda.
  • Opcionales: estas variables las agrego como opcionales porque podrían causar sobreajuste en los modelos.
    • Para cada vuelo -FLTID promedio el tiempo de retraso. Los vuelos que están en el train que no pertenecen al test les agrego NA. También se podría calcular la mediana en lugar del promedio.
    • Para cada vuelo obtengo la desviación estándar de la variable objetivo.
    • Para cada vuelo obtengo el mínimo y máximo tiempo de retraso.
    • Calculo el rango intercuartílico de retraso de cada vuelo.

Nuevas Train 1

# Nuevas variables train
dataTrain %>% 
  mutate(dayWeek = weekdays(DATOP),
         mes = factor(month(DATOP)),
         anio = factor(year(DATOP)),
         trimestre = factor(quarters(DATOP)),
         weekYear = week(DATOP),
         endWeek = factor(if_else(dayWeek %in% c("sábado", "domingo"),
                           true = "Si", false = "No")),
         horaVuelo = hour(STD),
         horaVueloClas = if_else(
           horaVuelo >= 0 & horaVuelo < 6,
           true = "Magrudada",
           false = if_else(
             horaVuelo >= 6 & horaVuelo < 12,
             true = "Mañana",
             false = if_else(
               horaVuelo >= 12 & horaVuelo < 18,
               true = "Tarde",
               false = "Noche"))),
         tiempoVuelo = as.numeric(STA - STD)/60,
         tiempoVuelo = ifelse(tiempoVuelo > 24, NA, tiempoVuelo),
         tiempoClas = if_else(tiempoVuelo <= 2,
                              true = "Corto",
                              false = if_else(
                                tiempoVuelo > 5,
                                true = "Largo",
                                false = "Moderado"))) %>% 
  group_by(DEPSTN) %>% 
  mutate(vuelosPartida = n()) %>% 
  ungroup() %>% 
  group_by(ARRSTN) %>% 
  mutate(vuelosDestino = n()) %>% 
  ungroup() %>% 
  group_by(AC) %>% 
  mutate(vuelosAC = n()) %>% 
  group_by(FLTID) %>% 
  mutate(promedioRetraso = mean(target, na.rm = TRUE),
         medianaRetraso = median(target, na.rm = TRUE),
         desvRetraso = sd(target, na.rm = TRUE)) %>% 
  ungroup() %>% 
  mutate_if(is.character, as.factor) %>% 
  select(target, everything()) ->
  newDataTrain
newDataTrain

Nuevas Test 1

# Nuevas variables test
dataTest %>% 
  mutate(dayWeek = weekdays(DATOP),
         mes = factor(month(DATOP)),
         anio = factor(year(DATOP)),
         trimestre = factor(quarters(DATOP)),
         weekYear = week(DATOP),
         endWeek = factor(if_else(dayWeek %in% c("sábado", "domingo"),
                           true = "Si", false = "No")),
         horaVuelo = hour(STD),
         horaVueloClas = if_else(
           horaVuelo >= 0 & horaVuelo < 6,
           true = "Magrudada",
           false = if_else(
             horaVuelo >= 6 & horaVuelo < 12,
             true = "Mañana",
             false = if_else(
               horaVuelo >= 12 & horaVuelo < 18,
               true = "Tarde",
               false = "Noche"))),
         tiempoVuelo = as.numeric(STA - STD)/60,
         tiempoVuelo = ifelse(tiempoVuelo > 24, NA, tiempoVuelo),
         tiempoClas = if_else(tiempoVuelo <= 2,
                              true = "Corto",
                              false = if_else(
                                tiempoVuelo > 5,
                                true = "Largo",
                                false = "Moderado"))) %>% 
  group_by(DEPSTN) %>% 
  mutate(vuelosPartida = n()) %>% 
  ungroup() %>% 
  group_by(ARRSTN) %>% 
  mutate(vuelosDestino = n()) %>% 
  ungroup() %>% 
  group_by(AC) %>% 
  mutate(vuelosAC = n()) %>% 
  ungroup() %>% 
  mutate_if(is.character, as.factor) ->
  newDataTest
# Juntando datos de tiempos de espera (target)
left_join(newDataTest,
          newDataTrain %>%
            select(FLTID, promedioRetraso:desvRetraso),
          by = "FLTID") %>%
  distinct(ID, .keep_all = TRUE) ->
  newDataTest
newDataTest

Exportando datos 1

# Nuevas 1
save(newDataTrain, file = "../myData/Train1.Rdata", compress = "xz")
save(newDataTest, file = "../myData/Test1.Rdata", compress = "xz")

Nuevas Train 2

# Fechas especiales
fechas <- c("5_1", "9_19", "3_8", "1_1", "1_6", "10_31", "12_24", "12_25",
            "12_31")

# Nuevas variables train
dataTrain %>% 
  mutate(dayWeek = weekdays(DATOP),
         mes = factor(month(DATOP)),
         dia = mday(DATOP),
         anio = factor(year(DATOP)),
         trimestre = factor(quarters(DATOP)),
         weekYear = week(DATOP),
         endWeek = factor(if_else(dayWeek %in% c("sábado", "domingo"),
                           true = "Si", false = "No")),
         finMes = if_else(dia %in% c(28, 29, 30, 31),
                          true = "Si", false = "No"),
         horaVuelo = hour(STD),
         horaVueloClas = if_else(
           horaVuelo >= 0 & horaVuelo < 6,
           true = "Magrudada",
           false = if_else(
             horaVuelo >= 6 & horaVuelo < 12,
             true = "Mañana",
             false = if_else(
               horaVuelo >= 12 & horaVuelo < 18,
               true = "Tarde",
               false = "Noche"))),
         tiempoVuelo = as.numeric(STA - STD)/60,
         tiempoVuelo = ifelse(tiempoVuelo > 24, NA, tiempoVuelo),
         tiempoClas = if_else(tiempoVuelo <= 2,
                              true = "Corto",
                              false = if_else(
                                tiempoVuelo > 5,
                                true = "Largo",
                                false = "Moderado"))) %>% 
  group_by(DEPSTN) %>% 
  mutate(vuelosPartida = n()) %>% 
  ungroup() %>% 
  group_by(ARRSTN) %>% 
  mutate(vuelosDestino = n()) %>% 
  ungroup() %>% 
  group_by(AC) %>% 
  mutate(vuelosAC = n()) %>% 
  group_by(FLTID) %>% 
  mutate(promedioRetraso = mean(target, na.rm = TRUE),
         medianaRetraso = median(target, na.rm = TRUE),
         desvRetraso = sd(target, na.rm = TRUE),
         minRetraso = min(target, na.rm = TRUE),
         maxRetraso = max(target, na.rm = TRUE),
         RicRetraso = IQR(target, na.rm = TRUE)) %>% 
  ungroup() %>% 
  unite(mes, dia, col = "diaMes", remove = FALSE) %>% 
  mutate(fechaEspecial = if_else(diaMes %in% fechas,
                                 true = "Si", false = "No")) %>% 
  mutate_if(is.character, as.factor) %>% 
  select(target, everything()) %>% 
  select(-diaMes) ->
  newDataTrain
  
newDataTrain

Nuevas Test 2

# Nuevas variables test
dataTest %>% 
  mutate(dayWeek = weekdays(DATOP),
         mes = factor(month(DATOP)),
         dia = mday(DATOP),
         anio = factor(year(DATOP)),
         trimestre = factor(quarters(DATOP)),
         weekYear = week(DATOP),
         endWeek = factor(if_else(dayWeek %in% c("sábado", "domingo"),
                           true = "Si", false = "No")),
         finMes = if_else(dia %in% c(28, 29, 30, 31),
                          true = "Si", false = "No"),
         horaVuelo = hour(STD),
         horaVueloClas = if_else(
           horaVuelo >= 0 & horaVuelo < 6,
           true = "Magrudada",
           false = if_else(
             horaVuelo >= 6 & horaVuelo < 12,
             true = "Mañana",
             false = if_else(
               horaVuelo >= 12 & horaVuelo < 18,
               true = "Tarde",
               false = "Noche"))),
         tiempoVuelo = as.numeric(STA - STD)/60,
         tiempoVuelo = ifelse(tiempoVuelo > 24, NA, tiempoVuelo),
         tiempoClas = if_else(tiempoVuelo <= 2,
                              true = "Corto",
                              false = if_else(
                                tiempoVuelo > 5,
                                true = "Largo",
                                false = "Moderado"))) %>% 
  unite(mes, dia, col = "diaMes", remove = FALSE) %>% 
  mutate(fechaEspecial = if_else(diaMes %in% fechas,
                                 true = "Si", false = "No")) %>% 
  group_by(DEPSTN) %>% 
  mutate(vuelosPartida = n()) %>% 
  ungroup() %>% 
  group_by(ARRSTN) %>% 
  mutate(vuelosDestino = n()) %>% 
  ungroup() %>% 
  group_by(AC) %>% 
  mutate(vuelosAC = n()) %>% 
  ungroup() %>% 
  select(-diaMes) %>% 
  mutate_if(is.character, as.factor) ->
  newDataTest

# Juntando datos de tiempos de espera (target)
left_join(newDataTest,
          newDataTrain %>%
            select(FLTID, promedioRetraso:RicRetraso),
          by = "FLTID") %>%
  distinct(ID, .keep_all = TRUE) ->
  newDataTest

newDataTest

Exportando datos 2

# Nuevas 2
save(newDataTrain, file = "../myData/Train2.Rdata", compress = "xz")
save(newDataTest, file = "../myData/Test2.Rdata", compress = "xz")